home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CU Amiga Super CD-ROM 11
/
CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso
/
cucd
/
programming
/
oberonv4
/
source
/
system
/
diskette.mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1996-06-15
|
17KB
|
471 lines
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
Syntax10b.Scn.Fnt
MODULE Diskette; (* Marc Pilloud, 19. Apr 94 *)
IMPORT
SYSTEM, Amiga, MFM := AmigaMFM, Exec := AmigaExec,
Files, Kernel;
(* ORIGINAL OBERON TYPES *)
FileDesc = RECORD (* image of dir entry *)
name:ARRAY 22 OF CHAR; (* size(FileDesc) = 32 Byte *)
time,date:INTEGER;
head:INTEGER;
size:LONGINT
END;
File = POINTER TO FileHandle;
FileHandle = RECORD
prev,next:File;
file:FileDesc
END;
EntryHandler* = PROCEDURE(name:ARRAY OF CHAR; date, time, size:LONGINT);
MFMPtr = POINTER TO MFM.IOExtMFM;
CONST
(* AMIGA VERSION CONST *)
ON = TRUE;
OFF = FALSE;
tries = 3; (* Anzahl Versuch ein Kommando auszufhren *)
sectorSize = LONG(MFM.sector);
trackSize = LONG(MFM.numSecs*MFM.sector); (* 9 sectors * 512 Bytes *)
(* ORIGINAL OBERON CONST *)
Oberon* = 0E9X;
MSDOS* = 0F9X;
(* AMIGA VERSION VAR *)
mfmPortLI : Exec.MsgPortPtr;
mfmioLI : MFM.IOExtMFMPtr;
mfmOpen : BOOLEAN;
unit : LONGINT;
update : BOOLEAN; (*IF update THEN nach jedem PutSector Daten zurckschreiben *)
stopMotor : BOOLEAN; (*IF stopMotor THEN nach jedem Put-,GetSector Motor abschalten *)
err* : LONGINT;
(* ORIGINAL OBERON VAR *)
res* :INTEGER; (* result of file-oriented operation, error = ( res # 0) *)
sect* :LONGINT;
busy* :BOOLEAN; (* state of device driver *)
dir : File;
trailer : FileDesc;
usedF, usedC : INTEGER;
FAT : ARRAY 720 OF INTEGER;
(*===========================================================================*)
(* DEVICE DRIVER *)
(*===========================================================================*)
(*****************************************************************************)
(* CLOSE *)
(*****************************************************************************)
PROCEDURE Close*;
BEGIN
IF mfmOpen THEN Exec.CloseDevice(mfmioLI); mfmOpen := FALSE END;
IF mfmPortLI # 0 THEN Exec.DeleteMsgPort(mfmPortLI); mfmPortLI:=0 END;
IF mfmioLI # 0 THEN Exec.DeleteIORequest(mfmioLI); mfmioLI:=0 END
END Close;
(*****************************************************************************)
(* SET DRIVE *)
(*****************************************************************************)
PROCEDURE SetDrive*(unitNr:LONGINT);
VAR mfmio:MFMPtr;
BEGIN
mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI); (* Type cast *)
IF (unitNr >= 0) & (unitNr <= 3) & ((unit#unitNr) OR (~mfmOpen)) THEN
unit := unitNr;
IF mfmPortLI = 0 THEN mfmPortLI := Exec.CreateMsgPort() END;
IF mfmPortLI = 0 THEN HALT(50) END;
IF mfmioLI = 0 THEN
mfmioLI := Exec.CreateIORequest(mfmPortLI, SIZE(MFM.IOExtMFM));
mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI); (* Type cast *)
END;
IF mfmioLI = 0 THEN HALT(50) END;
IF mfmOpen THEN Exec.CloseDevice(mfmioLI) END; (* Altes Device schliessen *)
mfmOpen:= (Exec.OpenDevice(MFM.name,unit,mfmioLI,{})=0)
& (mfmio.req.error=0); (* Neues Device ffnen *)
END;
IF ~mfmOpen THEN HALT(50) END;
END SetDrive;
(*****************************************************************************)
(* DoCommand and Error Handling *)
(*****************************************************************************)
PROCEDURE DoCommand(com:INTEGER):LONGINT;
VAR try:SHORTINT;
mfmio:MFMPtr;
BEGIN
mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI); (* Type cast *)
busy := TRUE;
mfmio.req.command:=com;
try := 1;
REPEAT
err := Exec.DoIO(mfmioLI);
INC(try)
UNTIL (err=0) OR (try>tries);
IF err#0 THEN
IF (err#23) & (err#28) THEN HALT(51) END;
ELSE busy := FALSE
END;
RETURN err
END DoCommand;
(*****************************************************************************)
(* GetDiskChanges, StopMotor, ClearBuf, Update *)
(*****************************************************************************)
PROCEDURE GetDiskChanges():LONGINT;
VAR mfmio:MFMPtr;
BEGIN
mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI); (* Type cast *)
mfmio.req.command:=MFM.changeNum;
IF Exec.DoIO(mfmioLI)#0 THEN HALT(51) END;
RETURN (mfmio.req.actual)
END GetDiskChanges;
PROCEDURE StopMotor;
VAR mfmio:MFMPtr;
BEGIN
mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI); (* Type cast *)
mfmio.req.length:=0;
mfmio.req.command:=MFM.motor;
IF Exec.DoIO(mfmioLI)#0 THEN HALT(51) END
END StopMotor;
PROCEDURE ClearBuf;
VAR mfmio:MFMPtr;
BEGIN
mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI); (* Type cast *)
mfmio.req.command:=MFM.extClear;
IF Exec.DoIO(mfmioLI)#0 THEN HALT(51) END
END ClearBuf;
PROCEDURE Update;
BEGIN
IF DoCommand(MFM.extUpdate)#0 THEN HALT(53) END
END Update;
(*****************************************************************************)
(* RESET *)
(*****************************************************************************)
PROCEDURE Reset*;
VAR mfmio:MFMPtr;
BEGIN
mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI); (* Type cast *)
mfmio.secLabel := 0; (* Sektor-Label wird nicht verwendet *)
mfmio.count := GetDiskChanges(); (* Diskwechselzhler setzten *)
StopMotor; (* Motor abschalten *)
ClearBuf; (* Interner DiskBuffer lschen *)
stopMotor := ON; update := ON;
END Reset;
(*****************************************************************************)
(* GetSector *)
(*****************************************************************************)
PROCEDURE GetSector*(sec:INTEGER; VAR buf:ARRAY OF SYSTEM.BYTE; off:INTEGER);
VAR oldcount:LONGINT;
mfmio:MFMPtr;
BEGIN
mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI); (* Type cast *)
IF busy THEN Reset END;
sect := sec;
oldcount := mfmio.count;
mfmio.count := GetDiskChanges();
IF oldcount # mfmio.count THEN ClearBuf END;
mfmio.req.offset := sec*sectorSize;
mfmio.req.data := SYSTEM.ADR(buf[off]);
mfmio.req.length := sectorSize;
IF DoCommand(MFM.extRead)#0 THEN HALT(52) END;
IF stopMotor THEN StopMotor END;
END GetSector;
(*****************************************************************************)
(* PUT SECTOR *)
(*****************************************************************************)
PROCEDURE PutSector*(sec:INTEGER; VAR buf:ARRAY OF SYSTEM.BYTE; off:INTEGER);
VAR mfmio:MFMPtr;
BEGIN
mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI); (* Type cast *)
IF busy THEN Reset END;
sect := sec;
mfmio.count := GetDiskChanges();
mfmio.req.offset := sec*sectorSize;
mfmio.req.data := SYSTEM.ADR(buf[off]);
mfmio.req.length := sectorSize;
IF DoCommand(MFM.extWrite)#0 THEN HALT(53) END;
IF update THEN Update END;
IF stopMotor THEN StopMotor END;
END PutSector;
(*****************************************************************************)
(* FORMAT *)
(*****************************************************************************)
PROCEDURE Format*;
VAR c:INTEGER;
buf: ARRAY trackSize OF SYSTEM.BYTE;
mfmio:MFMPtr;
BEGIN
mfmio:=SYSTEM.VAL(MFMPtr,mfmioLI); (* Type cast *)
IF busy THEN Reset END;
c:=0; WHILE c<trackSize DO buf[c]:=SYSTEM.VAL(SYSTEM.BYTE,0E5H); INC(c) END;
c:=0;
WHILE c < 160 DO
mfmio.count := GetDiskChanges();
mfmio.req.offset := c*trackSize; (* Track Nummer *)
mfmio.req.data := SYSTEM.ADR(buf[0]);
mfmio.req.length := trackSize;
IF DoCommand(MFM.extFormat)#0 THEN HALT(51) END;
INC(c);
END;
StopMotor; (* Motor abschalten *)
END Format;
(*===========================================================================*)
(* DIRECTORY PROCEDURES *)
(*===========================================================================*)
(*****************************************************************************)
(* COPY AND TURN FILEDESC (Litleendian <-> Bigendian) *)
(*****************************************************************************)
PROCEDURE CopyFileDesc(VAR a,b:FileDesc);
TYPE TWOINT=ARRAY 2 OF INTEGER;
VAR size:TWOINT;
BEGIN
b.name := a.name; b.name[21] := 0X;
b.time := SYSTEM.ROT(a.time,8);
b.date := SYSTEM.ROT(a.date,8);
b.head := SYSTEM.ROT(a.head,8);
size := SYSTEM.VAL(TWOINT,a.size);
b.size := SYSTEM.LSH(LONG(SYSTEM.ROT(size[1],8)),16)+SYSTEM.ROT(size[0],8);
END CopyFileDesc;
PROCEDURE InitDir*;
VAR t, d: LONGINT; i: INTEGER;
BEGIN
trailer.name[0] := 0X;
NEW(dir); dir.file.name[0] := 0FFX;
dir.file.name[11] := 8X; (* def as vol label *)
dir.next := dir; dir.prev := dir;
usedF := 1; usedC := 7;
FAT[0] := -1; FAT[1] := -1;
i := 2;
REPEAT FAT[i] := 0; FAT[i+1] := 0; INC(i,2) UNTIL i=720
END InitDir;
PROCEDURE Clusters (size:LONGINT):INTEGER;
BEGIN RETURN SHORT((size + 1023) DIV 1024);
END Clusters;
PROCEDURE findFile (name: ARRAY OF CHAR; VAR f: File);
BEGIN
f := dir.next;
WHILE f.file.name < name DO f := f.next END;
END findFile;
PROCEDURE ReadDir*;
VAR f,g :File;
n :LONGINT;
s,i,j,n0,n1:INTEGER;
buf : ARRAY 1536 OF CHAR;
dBuf: ARRAY 16 OF FileDesc; (* size(dBuf) = 512 Bytes *)
BEGIN
stopMotor := OFF; (* Motor laufen lassen *)
(* read boot sector *)
GetSector(0, buf, 0);
IF (buf[21] # 0F9X) & (buf[21] # 0E9X) THEN HALT(54) END;
(* read volum label *)
GetSector(7, dBuf, 0);
NEW(f); CopyFileDesc(dBuf[0],f.file);
IF f.file.name[11] # 08X THEN HALT(54) END; (* not volume label *)
IF (f.file.name[0] < 0E5X) & (f.file.name[0] # 0X) THEN HALT(54) END;
(* not Oberon Format *)
f.file.name[0] := 0FFX;
(* read dir *)
f.prev := f; f.next := f; dir := f;
usedF := 1; usedC := 7;
s := 7; j := 1;
LOOP
IF (dBuf[j].name[0] = 0X) OR (dBuf[j].name[0] = 0E5X) THEN EXIT END;
NEW(f); CopyFileDesc(dBuf[j],f.file);
findFile(f.file.name, g);
f.next := g; g.prev.next := f; f.prev := g.prev; g.prev := f;
INC(usedF); usedC := usedC + Clusters(f.file.size);
INC(j);
IF j = 16 THEN INC(s); j:=0;
IF s = 14 THEN EXIT END;
GetSector(s, dBuf, 0)
END
END;
(* read FAT *)
GetSector(1, buf, 0);
GetSector(2, buf, 512);
GetSector(3, buf, 1024);
stopMotor := ON; StopMotor; (* Motor ausschalten *)
FAT[0] := -1; FAT[1] := -1;
i := 2; j := 3;
REPEAT
n := ORD(buf[j+2]); n := n*256;
n := n + ORD(buf[j+1]); n := n*256;
n := n + ORD(buf[j]);
n0 := SHORT (n MOD 4096); n1 := SHORT(n DIV 4096);
IF n0 > 2047 THEN n0 := n0 - 4096 END;
IF n1 > 2047 THEN n1 := n1 - 4096 END;
FAT[i] := n0; FAT[i+1] := n1;
i := i + 2; j := j + 3
UNTIL i = 720
END ReadDir;
PROCEDURE WriteDir*;
VAR f: File;
n: LONGINT;
s, i, j, n0, n1:INTEGER;
buf : ARRAY 1536 OF CHAR; (* 3*512 (sectors 1 2 3) *)
dBuf: ARRAY 16 OF FileDesc;
BEGIN
update := OFF; stopMotor := OFF;
(* write boot sector *)
buf[21] := 0F9X;
PutSector(0, buf, 0);
(* write FAT *)
buf[0] := 0F9X;
buf[1] := 0FFX;
buf[2] := 0FFX;
i := 2; j := 3;
REPEAT
n0 := FAT[i]; n1 := FAT[i+1];
IF n0<0 THEN n0 := n0 + 4096 END;
IF n1<0 THEN n1 := n1 + 4096 END;
n := n1; n := n*4096 + n0;
buf[j] := CHR(SHORT(n MOD 256)); n := n DIV 256;
buf[j+1] := CHR(SHORT(n MOD 256)); n := n DIV 256;
buf[j+2] := CHR(SHORT(n));
i:=i+2; j:=j+3
UNTIL i=720;
PutSector(1, buf, 0);
PutSector(2, buf, 512);
PutSector(3, buf, 1024);
(* write dir *)
s := 7; j := 0; f := dir;
REPEAT
CopyFileDesc(f.file,dBuf[j]); INC(j);
IF j = 16 THEN PutSector(s, dBuf, 0); INC(s); j := 0 END;
f := f.next
UNTIL f = dir;
IF s # 14 THEN
CopyFileDesc(trailer,dBuf[j]);
PutSector(s,dBuf,0)
END;
update := ON; Update;
stopMotor:= ON; StopMotor;
END WriteDir;
PROCEDURE GetData*(VAR date,time:LONGINT; VAR nofFiles,nofClusters:INTEGER);
BEGIN
date := dir.file.date; time := LONG(dir.file.time)*2;
nofFiles := usedF; nofClusters := usedC;
END GetData;
PROCEDURE Enumerate* (proc:EntryHandler);
VAR f:File;
BEGIN f:=dir.next;
WHILE f#dir DO
proc(f.file.name, f.file.date, LONG(f.file.time)*2, f.file.size);
f := f.next;
END
END Enumerate;
(*===========================================================================*)
(* FILES PROCEDURES *)
(*===========================================================================*)
PROCEDURE readFile (f: File; g: Files.File);
VAR Wg: Files.Rider;
size: LONGINT; i: INTEGER;
buf: ARRAY 1024 OF CHAR;
BEGIN
Files.Set(Wg, g, 0);
size := f.file.size;
IF size # 0 THEN
i := f.file.head;
stopMotor := OFF;
LOOP
GetSector(10 + 2*i, buf, 0);
GetSector(11 + 2*i, buf, 512);
IF FAT[i] = -1 THEN EXIT END;
Files.WriteBytes(Wg, buf, 1024);
size := size - 1024; i := FAT[i]
END;
stopMotor := ON; StopMotor;
Files.WriteBytes(Wg, buf, SHORT(size))
END
END readFile;
PROCEDURE deleteFile (f:File);
VAR i,j:INTEGER;
BEGIN
f.prev.next := f.next; f.next.prev := f.prev;
i := f.file.head;
REPEAT j:=FAT[i]; FAT[i]:=0; i:=j UNTIL i=-1
END deleteFile;
PROCEDURE addFile (f: Files.File; g, h: File);
VAR Rf: Files.Rider;
need, i, j: INTEGER;
buf: ARRAY 1024 OF CHAR;
BEGIN
Files.Set(Rf, f, 0);
need := Clusters(g.file.size);
IF need # 0 THEN
j := 2;
WHILE FAT[j] # 0 DO INC(j) END;
g.file.head := j;
stopMotor := OFF; update := OFF;
LOOP i := j;
Files.ReadBytes(Rf, buf, 1024);
PutSector(10 + 2*i, buf, 0);
PutSector(11 + 2*i, buf, 512);
DEC(need);
IF need = 0 THEN EXIT END;
INC(j);
WHILE FAT[j] # 0 DO INC(j) END;
FAT[i] := j
END;
FAT[i] := -1;
update := ON; Update;
stopMotor := ON; StopMotor
END;
g.next := h; h.prev.next := g; g.prev := h.prev; h.prev := g
END addFile;
PROCEDURE ReadAll*;
VAR f: File; g: Files.File; ch: CHAR;
BEGIN
ReadDir;
f := dir.next;
WHILE f # dir DO
g := Files.New(f.file.name); readFile(f, g); Files.Register(g); f := f.next
END
END ReadAll;
PROCEDURE ReadFile* (name: ARRAY OF CHAR);
VAR f: File; g: Files.File;
BEGIN
findFile(name, f);
IF f.file.name = name THEN
g := Files.New(name); readFile(f, g); Files.Register(g); res := 0
ELSE res := 1
END
END ReadFile;
PROCEDURE WriteFile* (name: ARRAY OF CHAR);
VAR f: Files.File; g, h: File; d, t: LONGINT; needC: INTEGER;
BEGIN res := 0;
NEW(g); g.file.name[11] := 0X; (*attributes*)
COPY(name, g.file.name);
f := Files.Old(name);
IF f # NIL THEN
g.file.size := Files.Length(f);
Kernel.GetClock(t, d);
g.file.date := SHORT(d); g.file.time := SHORT(t DIV 2);
findFile(g.file.name, h);
IF h.file.name = g.file.name THEN
needC := Clusters(g.file.size) - Clusters(h.file.size);
IF usedC + needC <= 720 THEN
deleteFile(h); addFile(f, g, h.next);
usedC := usedC + needC
ELSE res := 2
END
ELSE needC := Clusters(g.file.size);
IF (usedF < 112) & (usedC + needC <= 720) THEN
addFile(f, g, h);
INC(usedF); usedC := usedC + needC
ELSE res := 2
END
END
ELSE res := 1
END
END WriteFile;
PROCEDURE DeleteFile* (name: ARRAY OF CHAR);
VAR g: File;
BEGIN
findFile(name, g);
IF g.file.name = name THEN
deleteFile(g); DEC(usedF); usedC := usedC - Clusters(g.file.size); res := 0
ELSE res := 1
END
END DeleteFile;
(*===========================================================================*)
(* INITIAL ACTIONS *)
(*===========================================================================*)
BEGIN
Amiga.TermProcedure(Close);
mfmioLI := 0; mfmPortLI := 0; mfmOpen := FALSE; (* Initialisierung *)
SetDrive(0); Reset
END Diskette.